Syntax10.Scn.Fnt
StampElems
Alloc
5 Jul 95
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
MarkElems
Alloc
MODULE BalloonElems; (* HM 13 Oct 94 / 
(*------------------------------------------------------------------------------------
Automatically installs a TextFrame handler that intercepts MM+MR clicks and shows a popup text
with an explanation of the word that was clicked at.
The module also provides Balloon elements containing a dictionary of words and their explanation.
	Dictionary = {Word Explanation}.
	Word = string.
	Explanation = <any text not containing a quote>.
------------------------------------------------------------------------------------*)
IMPORT Display, Input, Files, Viewers, Texts, TextFrames, Oberon, PopupElems, HandlerElems, Bitmaps;
CONST
	left =2; middle = 1; right = 0;
	cancel = {left, middle, right};
	pixel = LONG(10000);
	CR = 0DX;
	grey2 = 13;
	Elem* = POINTER TO ElemDesc;
	ElemDesc* = RECORD (PopupElems.ElemDesc) END;
	Node = POINTER TO NodeDesc;
	NodeDesc = RECORD
		key: ARRAY 32 OF CHAR;
		pos: LONGINT;
		left, right: Node
	END;
	icon: Display.Pattern;
	SuperHandle: Display.Handler;
	stdDict: Texts.Text;  (*search a name in this dictionary if it is not found in any local dictionary*)
	tree: Node;	(*standard directory tree*)
	w: Texts.Writer;
(*----- Balloon Elements -----*)
PROCEDURE 
Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
	VAR e1: Elem; buf: Texts.Buffer; f: TextFrames.Frame; v, v0: Viewers.Viewer; x, y: INTEGER;
BEGIN
	WITH e: Elem DO
		WITH m: Texts.CopyMsg DO
			IF m.e = NIL THEN NEW(e1); m.e := e1 END;
			PopupElems.Handle(e, m)
		| m: Texts.IdentifyMsg DO
			m.mod := "BalloonElems"; m.proc := "Alloc"
		| m: TextFrames.DisplayMsg DO
			IF m.prepare THEN
				e.W := 13 * pixel; e.H := LONG(TextFrames.menuH-1) * pixel;
			ELSE e.name := ""; PopupElems.Handle(e, m);
				Display.CopyPattern(Display.white, icon, m.X0+2, m.Y0+2, Display.paint)
			END
		| m: TextFrames.TrackMsg DO
			Texts.Delete(e.menu, 0, e.menu.len); (*save it in recall buffer*)
			Texts.Write(w, " "); Texts.Append(e.menu, w.buf); PopupElems.MeasureMenu(e);
			Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
			v0 := Viewers.This(x, y-1); PopupElems.Handle(e, m); v := Viewers.This(x, y-1);
			Texts.Recall(buf);
			IF v # v0 THEN (*v is the edit viewer*)
				f := v.dsc.next(TextFrames.Frame);
				Texts.Delete(f.text, 0, 1); Texts.Append(f.text, buf); Texts.Save(f.text, 0, f.text.len, buf)
			END;
			Texts.Delete(e.menu, 0, 1); Texts.Append(e.menu, buf)
		ELSE PopupElems.Handle(e, m)
		END
END Handle;
PROCEDURE 
Alloc*;
	VAR e: Elem;
BEGIN
	NEW(e); e.handle := Handle; Texts.new := e
END Alloc;
PROCEDURE 
Insert*;
	VAR e: Elem; insert: TextFrames.InsertElemMsg;
BEGIN
	NEW(e); e.handle := Handle; e.name := ""; e.small := TRUE;
	e.menu := TextFrames.Text(""); PopupElems.MeasureMenu(e);
	insert.e := e; Viewers.Broadcast(insert)
END Insert;
(*----- Binary Tree -----*)
PROCEDURE 
Add (key: ARRAY OF CHAR; pos: LONGINT);
	VAR p, q, father: Node; n: INTEGER;
BEGIN
	p := tree.right; father := tree;
	WHILE p # NIL DO
		father := p;
		IF key < p.key THEN p := p.left ELSE p := p.right END
	END;
	NEW(q); COPY(key, q.key); q.pos := pos;
	IF key < father.key THEN father.left := q ELSE father.right := q END
END Add;
PROCEDURE 
Balance;  (*CACM Sept.86, pp. 902*)
	VAR p, tail, rest: Node; size, n, i: INTEGER;
	PROCEDURE Compress (root: Node; n: INTEGER);
		VAR p, son: Node; i: INTEGER;
	BEGIN
		p := root;
		FOR i := 1 TO n DO
			son := p.right; p.right := son.right; p := p.right;
			son.right := p.left; p.left := son
		END
	END Compress;
BEGIN
	(*--- make vine ---*)
	tail := tree; rest := tail.right;
	size := 0;
	WHILE rest # NIL DO
		IF rest.left = NIL THEN (*move tail down one*)
			tail := rest; rest := rest.right; INC(size)
		ELSE (*rotate*)
			p := rest.left; rest.left := p.right; p.right := rest; rest := p;
			tail.right := p
		END
	END;
	(*--- make tree ---*)
	i := 1; WHILE i <= size+1 DO i := i + i END;
	n := i DIV 2 - 1;
	Compress(tree, size - n);
	WHILE n > 1 DO
		n := n DIV 2; Compress(tree, n)
END Balance;
(*----- Name Lookup -----*)
PROCEDURE 
InvertRect (f: TextFrames.Frame; x, y, w, h: INTEGER);	(*clips to right and bottom frame margin*)
BEGIN
	IF x + w > f.X + f.W - f.right THEN w := f.X + f.W - f.right - x END;
	IF y >= f.Y + f.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END
END InvertRect;
PROCEDURE 
TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
BEGIN
	Input.Mouse(keys, x, y); keysum := keysum + keys;
	Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
END TrackMouse;
PROCEDURE 
CanBeWord (f: Display.Frame; x, y: INTEGER): BOOLEAN;
	VAR tf: TextFrames.Frame; r: Texts.Reader; ch: CHAR;
BEGIN
	tf := f(TextFrames.Frame);
	Texts.OpenReader(r, tf.text, TextFrames.Pos(tf, x, y)); Texts.Read(r, ch);
	RETURN (r.elem = NIL) & (x > tf.X + tf.barW)
END CanBeWord;
PROCEDURE 
GetDict (t: Texts.Text; VAR dict: Texts.Text);
	VAR r: Texts.Reader;
BEGIN
	Texts.OpenReader(r, t, 0); Texts.ReadElem(r);
	IF (r.elem # NIL) & (r.elem IS Elem) THEN dict := r.elem(Elem).menu ELSE dict := NIL END
END GetDict;
PROCEDURE 
WordBeg (t: Texts.Text; pos: LONGINT): LONGINT;
	VAR r: Texts.Reader; ch: CHAR; pos0: LONGINT;
BEGIN
	pos0 := pos; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
	WHILE (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = ".") DO
		DEC(pos); IF pos < 0 THEN RETURN 0 END;
		Texts.OpenReader(r, t, pos); Texts.Read(r, ch)
	END;
	IF pos < pos0 THEN INC(pos) END;
	RETURN pos
END WordBeg;
PROCEDURE 
WordEnd (t: Texts.Text; pos: LONGINT): LONGINT;
	VAR r: Texts.Reader; ch: CHAR; pos0: LONGINT;
BEGIN
	pos0 := pos; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
	WHILE (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = ".") DO
		INC(pos); Texts.Read(r, ch)
	END;
	IF pos = pos0 THEN INC(pos) END;
	RETURN pos
END WordEnd;
PROCEDURE 
GetName (ft: Texts.Text; pos: LONGINT; VAR name, fullName: ARRAY OF CHAR; VAR t: Texts.Text);
	VAR r: Texts.Reader; ch: CHAR; beg, end: LONGINT; i, j: INTEGER; imported: BOOLEAN;
		t0: Texts.Text; mod: ARRAY 32 OF CHAR;
BEGIN
	(*--- read name*)
	beg := WordBeg(ft, pos); end:= WordEnd(ft, pos);
	i := 0; Texts.OpenReader(r, ft, beg); imported := FALSE;
	WHILE beg < end DO
		Texts.Read(r, ch); name[i] := ch; INC(i); INC(beg);
		IF ch = "." THEN imported := TRUE END
	END;
	name[i] := 0X; COPY(name, fullName);
	(*--- resolve import if necessary*)
	t := ft;
	IF imported THEN
		i := 0; WHILE name[i] # "." DO mod[i] := name[i]; INC(i) END;
		mod[i] := "."; mod[i+1] := "M"; mod[i+2] := "o"; mod[i+3] := "d"; mod[i+4] := 0X;
		NEW(t0); Texts.Open(t0, mod);
		IF t0.len > 0 THEN
			t := t0; j := 0;
			REPEAT INC(i); name[j] := name[i]; INC(j) UNTIL name[i] = 0X
		END
END GetName;
PROCEDURE 
PrefixName (VAR name: ARRAY OF CHAR; f: TextFrames.Frame);
	VAR v: Viewers.Viewer; s: Texts.Scanner; i, j: INTEGER; nm: ARRAY 64 OF CHAR;
BEGIN
	v := Viewers.This(f.X, f.Y);
	Texts.OpenScanner(s, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(s);
	COPY(s.s, nm); i := s.len-1;
	WHILE (i >= 0) & (nm[i] # ".") DO DEC(i) END;
	INC(i); j := 0;
	WHILE (i < 63) & (name[j] # 0X) DO nm[i] := name[j]; INC(i); INC(j) END;
	nm[i] := 0X; COPY(nm, name)
END PrefixName;
PROCEDURE 
MeasureLine (VAR r: Texts.Reader; VAR lw, lh, dsr: INTEGER);
	VAR ch: CHAR; x, y, w, h, dx: INTEGER; p: Display.Pattern;
BEGIN
	Texts.Read(r, ch); lw := 0; lh := 0; dsr := 0;
	WHILE ~r.eot & (ch # CR) DO
		IF r.elem # NIL THEN
			h := SHORT(r.elem.H DIV pixel); dx := SHORT(r.elem.W DIV pixel); y := r.fnt.minY
		ELSE
			Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(y, r.fnt.height * r.voff DIV 64);
		END;
		IF y < dsr THEN dsr := y END;
		IF y + h > lh THEN lh := y + h END;
		INC(lw, dx);
		Texts.Read(r, ch)
	END;
	dsr := -dsr; lh := lh + dsr;
	IF (ch = CR) & (lh = 0) THEN lh := 10; dsr := 0; lw := 8 END
END MeasureLine;
PROCEDURE 
Popup* (t: Texts.Text; beg, end: LONGINT);
	VAR r: Texts.Reader; ch: CHAR; x, y, w, h, dx, bx, by, bw, bh, lw, i, X, Y: INTEGER; b: Bitmaps.Bitmap; p: Display.Pattern;
		lh, dsr: ARRAY 128 OF INTEGER; e: Texts.Elem; dsp: TextFrames.DisplayMsg; keys: SET;
BEGIN
	(*--- measure text*)
	Input.Mouse(keys, x, y);
	bw := 0; bh := 0;
	Texts.OpenReader(r, t, beg); i := 0;
	WHILE Texts.Pos(r) < end DO
		MeasureLine(r, lw, lh[i], dsr[i]);
		IF lw > bw THEN bw := lw END;
		bh := bh + lh[i]; INC(i)
	END;
	INC(bw, 8); IF bw > Display.Width THEN bw := Display.Width END;
	INC(bh, 8); IF bh > Display.Height THEN bh := Display.Height END;
	bx := x; IF bx + bw > Display.Width THEN bx := Display.Width - bw END;
	by := y + 10; IF by + bh > Display.Height THEN by := Display.Height - bh END;
	(*--- show text*)
	b := Bitmaps.New(bw, bh); Bitmaps.CopyBlock(Bitmaps.Disp, b, bx, by, bw, bh, 0, 0, 0);
	Display.ReplConst(Display.white, bx, by, bw, bh, Display.replace);
	Display.ReplConst(grey2, bx+1, by+1, bw-2, bh-2, Display.replace);
	X := bx + 4; Y := by + bh - 4 - lh[0] + dsr[0];
	Texts.OpenReader(r, t, beg); i := 0;
	WHILE beg < end DO
		Texts.Read(r, ch); INC(beg);
		IF ch = CR THEN
			INC(i); X := bx + 4; Y := Y - dsr[i-1] - lh[i] + dsr[i]
		ELSIF r.elem # NIL THEN
			e := r.elem; y := r.fnt.minY;
			dsp.prepare := FALSE; dsp.fnt := r.fnt; dsp.col := r.col; dsp.pos := beg - 1;
			dsp.frame := NIL; dsp.X0 := X; dsp.Y0 := Y+y; dsp.elemFrame := NIL;
			e.handle(e, dsp); INC(X, SHORT(e.W DIV pixel))
		ELSE
			Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(y, r.fnt.height * r.voff DIV 64);
			Display.CopyPattern(Display.white, p, X+x, Y+y, Display.paint); X := X + dx
		END
	END;
	(*--- wait until right mouse button is released*)
	REPEAT Input.Mouse(keys, x, y) UNTIL ~(right IN keys);
	Bitmaps.CopyBlock(b, Bitmaps.Disp, 0, 0, bw, bh, bx, by, 0)
END Popup;
PROCEDURE 
GetBounds (VAR s: Texts.Scanner; t: Texts.Text; VAR beg, end: LONGINT);
	VAR ch: CHAR;
BEGIN
	IF ~s.eot THEN beg := Texts.Pos(s); Texts.Read(s, ch);
		WHILE ~s.eot & (ch <= " ") & (ch # Texts.ElemChar) DO INC(beg); Texts.Read(s, ch) END;
		end := beg;
		WHILE ~s.eot & (ch # '"') DO INC(end); Texts.Read(s, ch) END;
		REPEAT DEC(end); Texts.OpenReader(s, t, end); Texts.Read(s, ch) UNTIL (ch > " ") OR (ch = Texts.ElemChar);
		INC(end);
		IF beg >= end THEN beg := -1 END
	ELSE beg := -1
	END;
END GetBounds;
PROCEDURE 
Show (nm: ARRAY OF CHAR; dict: Texts.Text; VAR done: BOOLEAN);
	VAR s: Texts.Scanner; ch: CHAR; name: ARRAY 64 OF CHAR; beg, end: LONGINT;
BEGIN
	COPY(nm, name); (*circumvent compiler bug*)
	Texts.OpenScanner(s, dict, 0); Texts.Scan(s);
	WHILE ~s.eot & ~((s.class = Texts.String) & (s.s = name)) DO
		Texts.Scan(s)
	END;
	GetBounds(s, dict, beg, end);
	IF beg >= 0 THEN Popup(dict, beg, end) END;
	done := beg >= 0
END Show;
PROCEDURE 
ShowStd (name: ARRAY OF CHAR; VAR done: BOOLEAN);
	VAR p: Node; s: Texts.Scanner; beg, end: LONGINT;
BEGIN
	p := tree.right;
	WHILE (p # NIL) & (p.key # name) DO
		IF name < p.key THEN p := p.left ELSE p := p.right END
	END;
	IF p # NIL THEN
		Texts.OpenScanner(s, stdDict, p.pos);
		GetBounds(s, stdDict, beg, end);
		Popup(stdDict, beg, end)
	END;
	done := p # NIL
END ShowStd;
PROCEDURE 
TrackWord (f: TextFrames.Frame; VAR m: Oberon.InputMsg);
	VAR keys: SET; new, old: TextFrames.Location; dict, t: Texts.Text; name, fullName: ARRAY 64 OF CHAR;
		beg, end: LONGINT; x, y: INTEGER; done: BOOLEAN;
BEGIN
	TextFrames.LocateWord(f, x, y, old); InvertRect(f, old.x, old.y, old.dx, 2);
	m.keys := {};
	TrackMouse(x, y, keys, m.keys);
	WHILE (keys # {}) & ~(left IN keys) DO
		TextFrames.LocateWord(f, x, y, new);
		IF new.pos # old.pos THEN
			InvertRect(f, old.x, old.y, old.dx, 2); InvertRect(f, new.x, new.y, new.dx, 2); old := new
		END;
		IF keys = {middle, right} THEN
			GetName(f.text, TextFrames.Pos(f, x, y), name, fullName, t);
			GetDict(t, dict);
			done := FALSE;
			IF dict # NIL THEN Show(name, dict, done) END;
			IF ~done THEN ShowStd(fullName, done) END;
			IF ~done THEN
				PrefixName(fullName, f);
				ShowStd(fullName, done)
			END;
			IF done THEN m.keys := cancel END
		END;
		TrackMouse(x, y, keys, m.keys)
	END;
	InvertRect(f, old.x, old.y, old.dx, 2);
	IF m.keys # cancel THEN EXCL (m.keys, left) END
END TrackWord;
PROCEDURE 
FrameHandler* (f: Display.Frame; VAR m: Display.FrameMsg);
BEGIN
	WITH f: TextFrames.Frame DO
		WITH m: Oberon.InputMsg DO
			IF (m.id = Oberon.track) & (middle IN m.keys) & CanBeWord(f, m.X, m.Y) THEN
				TrackWord(f(TextFrames.Frame), m);
				IF m.keys # cancel THEN SuperHandle(f, m) END
			ELSE SuperHandle(f, m)
			END
		ELSE SuperHandle(f, m)
		END
END FrameHandler;
PROCEDURE 
LoadDictionary*;
	VAR s: Texts.Scanner;
BEGIN
	NEW(tree); tree.key := "";
	IF Files.Old("Balloon.Text") # NIL THEN
		NEW(stdDict); Texts.Open(stdDict, "Balloon.Text");
		Texts.OpenScanner(s, stdDict, 0); Texts.Scan(s);
		WHILE ~s.eot DO
			IF s.class = Texts.String THEN Add(s.s, Texts.Pos(s)) END;
			Texts.Scan(s)
		END;
		Balance
END LoadDictionary;
PROCEDURE Install*;	(*loads the module, installs the handler, and reads the dictionary*)
END Install;
PROCEDURE 
InitIcon;
	VAR line: ARRAY 9 OF SET;
BEGIN
	line[8] := {};
	line[7] := {1..6};
	line[6] := {0, 7};
	line[5] := {0, 7};
	line[4] := {0, 7};
	line[3] := {1..4, 6};
	line[2] := {5, 6};
	line[1] := {6, 7};
	icon := Display.NewPattern(line, 8, 8);
END InitIcon;
BEGIN
	InitIcon;
	HandlerElems.SetHandler("BalloonElems.FrameHandler", FrameHandler, SuperHandle);
	LoadDictionary;
	Texts.OpenWriter(w)
END BalloonElems.